home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbsmc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-26  |  33.6 KB  |  888 lines
  1. (*===========================================================================*)
  2. (* Send msg command                                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. UNIT BBSMC;
  12.  
  13. INTERFACE
  14.  
  15.   PROCEDURE send_msg_cmd(cmd_string : STRING);
  16.  
  17. IMPLEMENTATION
  18.  
  19.   USES
  20.     bbauth,
  21.     bbbid,
  22.     bbcmsg,
  23.     bbdummy,
  24.     bbfin,
  25.     bblog,
  26.     bbmdata,
  27.     bbmem,
  28.     bbmess,
  29.     bbmf,
  30.     bbmisc2,
  31.     bbrdata,
  32.     bbrunerr,
  33.     bbsdata,
  34.     bbsess,
  35.     bbsto,
  36.     bbstr;
  37.  
  38. (*===========================================================================*)
  39. (* Send msg command                                                          *)
  40. (*      Entered when 'S' received by command processor                       *)
  41. (*===========================================================================*)
  42.  
  43. PROCEDURE send_msg_cmd(cmd_string : STRING);
  44.  
  45.   VAR
  46.     abbs     : BOOLEAN;
  47.     b        : BOOLEAN;
  48.     i        : WORD;
  49.     l        : BOOLEAN;
  50.     m_t      : CHAR;
  51.     p        : str_ptr;
  52.     r_sw     : BOOLEAN;
  53.     t        : tcb_ptr;
  54.     this_act : action_msg_ptr;
  55.     t_str    : STRING;
  56.  
  57.   LABEL
  58.     do_reject,
  59.     no_reject;
  60.  
  61.   (*=========================================================================*)
  62.   (* Subroutine -- Send a reply                                              *)
  63.   (*=========================================================================*)
  64.  
  65.   PROCEDURE send_reply;
  66.  
  67.     VAR
  68.       code : INTEGER;
  69.       m    : msg_index_ptr;
  70.       n    : LONGINT;
  71.  
  72.     (*=======================================================================*)
  73.     (* Subroutine to do compare.  Written as a subroutine to save stack space*)
  74.     (*=======================================================================*)
  75.  
  76.     FUNCTION check_reply_subj : BOOLEAN;
  77.       VAR
  78.         s1 : STRING[30];
  79.         s2 : STRING[30];
  80.       BEGIN;
  81.         s1 := t_str;
  82.         upcase_str_var(s1);
  83.         s2 := cmd_string;
  84.         upcase_str_var(s2);
  85.         check_reply_subj := substr_compare(s2, 1, s1);
  86.       END;
  87.  
  88.     (*=======================================================================*)
  89.     (* Main line of send reply                                               *)
  90.     (*=======================================================================*)
  91.  
  92.     BEGIN;
  93.  
  94.       IF words(cmd_string) > 2 THEN
  95.         BEGIN;
  96.           send_message(message_err_wrd);
  97.           active_tcb^.error_sw := TRUE;
  98.           EXIT;
  99.         END;
  100.  
  101.       (*---------------------------------------------------------------------*)
  102.       (* Get message number and convert                                      *)
  103.       (*---------------------------------------------------------------------*)
  104.  
  105.       cmd_string := subword(@cmd_string, 2, 1);
  106.  
  107.       VAL(cmd_string, n, code);
  108.  
  109.       IF (code <> 0) OR (n < 1) OR (n > 65535) THEN
  110.         BEGIN;
  111.           send_message(message_err_ivm);
  112.           active_tcb^.error_sw := TRUE;
  113.           EXIT;
  114.         END;
  115.  
  116.       (*---------------------------------------------------------------------*)
  117.       (* Locate message                                                      *)
  118.       (*---------------------------------------------------------------------*)
  119.  
  120.       m := find_msg(n);
  121.  
  122.       IF m = NIL THEN
  123.         BEGIN;
  124.           send_message(message_rmc_nf);
  125.           active_tcb^.error_sw := TRUE;
  126.           EXIT;
  127.         END;
  128.  
  129.       (*---------------------------------------------------------------------*)
  130.       (* Compute subject                                                     *)
  131.       (*---------------------------------------------------------------------*)
  132.  
  133.       cmd_string := m^.msg_i_mb.msg_subj;
  134.       IF cmd_string = '' THEN
  135.         cmd_string := ' '
  136.       ELSE
  137.         BEGIN;
  138.           t_str := get_message(message_reply_prefix);
  139.           IF NOT check_reply_subj THEN
  140.             cmd_string := t_str + ' ' + cmd_string;
  141.         END;
  142.  
  143.       (*---------------------------------------------------------------------*)
  144.       (* Put the subject on the memory stack                                 *)
  145.       (*---------------------------------------------------------------------*)
  146.  
  147.       p := get_task_mem('SUB', LENGTH(cmd_string) + 1);
  148.  
  149.       MOVE(cmd_string, p^, LENGTH(cmd_string) + 1);
  150.  
  151.       (*---------------------------------------------------------------------*)
  152.       (* Fake a send command                                                 *)
  153.       (*---------------------------------------------------------------------*)
  154.  
  155.       cmd_string := 'S' + mt_private + ' ' + m^.msg_i_mb.msg_from
  156.                           +  ' @ ' + m^.msg_i_mb.msg_from_at;
  157.  
  158.       IF m^.msg_i_mb.msg_from_h <> '' THEN
  159.         cmd_string := cmd_string + '.' + m^.msg_i_mb.msg_from_h;
  160.  
  161.       (*---------------------------------------------------------------------*)
  162.       (* Tell user about the fake                                            *)
  163.       (*---------------------------------------------------------------------*)
  164.  
  165.       send_tnc_data_str(cmd_string + cr);
  166.  
  167.     END;
  168.  
  169.   (*=========================================================================*)
  170.   (* Function to see if message type is valid.   If not, return the prompt   *)
  171.   (* message number.  A prompt number of 1 means don't give prompt but an    *)
  172.   (* error.  A prompt number of 0 means type is ok.                          *)
  173.   (*=========================================================================*)
  174.  
  175.   FUNCTION check_type(type_char : CHAR) : WORD;
  176.  
  177.     BEGIN;
  178.  
  179.       (*---------------------------------------------------------------------*)
  180.       (* Assume everything is ok                                             *)
  181.       (*---------------------------------------------------------------------*)
  182.  
  183.       check_type := 0;
  184.  
  185.       (*---------------------------------------------------------------------*)
  186.       (* SYSOPs are allowed anything but ?                                   *)
  187.       (*---------------------------------------------------------------------*)
  188.  
  189.       IF (active_tcb^.uid_data.user_class >= user_c_rsu)
  190.                                                     AND (type_char <> '?') THEN
  191.         EXIT;
  192.  
  193.       (*---------------------------------------------------------------------*)
  194.       (* Emergency NTS mode?                                                 *)
  195.       (*---------------------------------------------------------------------*)
  196.  
  197.       IF opt_block.operate_mode.mode_acc_nonts
  198.                             AND active_port^.port_operate_mode.mode_acc_nonts
  199.                             AND (type_char = mt_nts) THEN
  200.         BEGIN;
  201.           check_type := message_not_accept_nts;
  202.           EXIT;
  203.         END;
  204.  
  205.       (*---------------------------------------------------------------------*)
  206.       (* Emergency list in use?                                              *)
  207.       (*---------------------------------------------------------------------*)
  208.  
  209.       IF opt_block.operate_mode.mode_acc_emer
  210.                             AND active_port^.port_operate_mode.mode_acc_emer
  211.                             AND (POS(type_char, opt_block.emer_types) = 0) THEN
  212.         BEGIN;
  213.           check_type := message_smc_type_emer;
  214.           EXIT;
  215.         END;
  216.  
  217.       (*---------------------------------------------------------------------*)
  218.       (* From here we are in normal mode so assume ok                        *)
  219.       (*---------------------------------------------------------------------*)
  220.  
  221.       check_type := 0;
  222.  
  223.       (*---------------------------------------------------------------------*)
  224.       (* If we have a '?' here, don't tolerate it                            *)
  225.       (*---------------------------------------------------------------------*)
  226.  
  227.       IF type_char = '?' THEN
  228.         check_type := message_smc_type;
  229.  
  230.       (*---------------------------------------------------------------------*)
  231.       (* If we reach here then BBS checking is done                          *)
  232.       (*---------------------------------------------------------------------*)
  233.  
  234.       IF active_tcb^.uid_data.user_class >= user_c_bu THEN
  235.         EXIT;
  236.  
  237.       (*---------------------------------------------------------------------*)
  238.       (* Normal mode, normal user.  If type not valid then give error        *)
  239.       (* Skip EXIT to save space since we fall out anyway                    *)
  240.       (*---------------------------------------------------------------------*)
  241.  
  242.       IF POS(type_char, opt_block.opt_types) = 0 THEN
  243.         check_type := message_smc_type;
  244.  
  245.       (*---------------------------------------------------------------------*)
  246.       (* Exit                                                                *)
  247.       (*---------------------------------------------------------------------*)
  248.  
  249.     END;
  250.  
  251.   (*=========================================================================*)
  252.   (* Subroutine -- Find a reject/deny action                                 *)
  253.   (*=========================================================================*)
  254.  
  255.   FUNCTION look_for_reject_deny : BOOLEAN;
  256.     BEGIN;
  257.  
  258.       (*---------------------------------------------------------------------*)
  259.       (* Look for reject by checking the action chain                        *)
  260.       (*---------------------------------------------------------------------*)
  261.  
  262.       this_act  := NIL;
  263.  
  264.       (*---------------------------------------------------------------------*)
  265.       (* Loop down the chain look for a reject action                        *)
  266.       (*---------------------------------------------------------------------*)
  267.  
  268.       REPEAT
  269.  
  270.         (*-------------------------------------------------------------------*)
  271.         (* Get tne next action from the chain                                *)
  272.         (*-------------------------------------------------------------------*)
  273.  
  274.         msg_action_check(@active_tcb^.curr_msg, this_act);
  275.  
  276.         (*-------------------------------------------------------------------*)
  277.         (* If we have searched the whole chain then we didn't find anything  *)
  278.         (*-------------------------------------------------------------------*)
  279.  
  280.         IF this_act = NIL THEN
  281.           BEGIN;
  282.             look_for_reject_deny := FALSE;
  283.             EXIT;
  284.           END;
  285.  
  286.       UNTIL (this_act^.action_type
  287.                               AND (action_msg_reject OR action_msg_deny)) <> 0;
  288.  
  289.       (*---------------------------------------------------------------------*)
  290.       (* Set result based on invert switch                                   *)
  291.       (*---------------------------------------------------------------------*)
  292.  
  293.       look_for_reject_deny :=
  294.                              (this_act^.action_type AND action_msg_invert) = 0;
  295.  
  296.     END;
  297.  
  298.   (*=========================================================================*)
  299.   (* Get reject message number                                               *)
  300.   (*=========================================================================*)
  301.  
  302.   FUNCTION get_reject_message : WORD;
  303.  
  304.     VAR
  305.       i     : BYTE;
  306.       w_ptr : ^WORD;
  307.  
  308.     BEGIN;
  309.  
  310.       IF ((this_act^.action_type AND action_msg_deny) = 0)
  311.                           OR (active_tcb^.uid_data.user_class = user_c_bu) THEN
  312.         get_reject_message := message_rejected
  313.       ELSE
  314.         BEGIN;
  315.           i := LENGTH(this_act^.action_info);
  316.           w_ptr := ADDR(this_act^.action_info[i + 1]);
  317.           get_reject_message := message_rejected + w_ptr^;
  318.         END
  319.  
  320.     END;
  321.  
  322.   (*=========================================================================*)
  323.   (* Autheticate send command                                                *)
  324.   (*=========================================================================*)
  325.  
  326.   PROCEDURE auth_send;
  327.  
  328.     VAR
  329.       work_1 : STRING;
  330.  
  331.     BEGIN;
  332.  
  333.       user_auth(work_1);
  334.  
  335.      END;
  336.  
  337.   (*=========================================================================*)
  338.   (* Main line of send_msg_cmd                                               *)
  339.   (*=========================================================================*)
  340.  
  341.   BEGIN;
  342.  
  343.     upcase_str_var(cmd_string);
  344.  
  345.     (*-----------------------------------------------------------------------*)
  346.     (* Authenticate send                                                     *)
  347.     (*-----------------------------------------------------------------------*)
  348.  
  349.     IF ((active_tcb^.tcb_access_mode.access_flags AND access_f_user) <> 0)
  350.               AND NOT active_tcb^.tcb_access_ok
  351.               AND (cmd_string <> 'S~') THEN
  352.       BEGIN;
  353.  
  354.         send_message(message_bad_access_send);
  355.  
  356.         auth_send;
  357.  
  358.         IF active_tcb^.error_sw THEN
  359.           BEGIN;
  360.             send_message(message_send_auth_fail);
  361.             EXIT;
  362.           END;
  363.  
  364.         active_tcb^.tcb_access_ok := TRUE;
  365.  
  366.       END;
  367.  
  368.     (*-----------------------------------------------------------------------*)
  369.     (* Check for SR                                                          *)
  370.     (*-----------------------------------------------------------------------*)
  371.  
  372.     IF cmd_string[2] <> 'R' THEN
  373.       r_sw := FALSE
  374.     ELSE
  375.       BEGIN;
  376.  
  377.         r_sw := TRUE;
  378.  
  379.         (*-------------------------------------------------------------------*)
  380.         (* If user did not supply a number, ask for one                      *)
  381.         (*-------------------------------------------------------------------*)
  382.  
  383.         IF words(cmd_string) = 1 THEN
  384.           BEGIN;
  385.             send_message(message_what_reply);
  386.             cmd_string := read_tnc_data_str;
  387.             strip_crlf(cmd_string);
  388.             IF cmd_string = '' THEN
  389.               BEGIN;
  390.                 send_message(message_nodata_can);
  391.                 EXIT;
  392.               END;
  393.             cmd_string := 'SR ' + cmd_string;
  394.           END;
  395.  
  396.         (*-------------------------------------------------------------------*)
  397.         (* Process the reply                                                 *)
  398.         (*-------------------------------------------------------------------*)
  399.  
  400.         send_reply;
  401.  
  402.         (*-------------------------------------------------------------------*)
  403.         (* If error then quit                                                *)
  404.         (*-------------------------------------------------------------------*)
  405.  
  406.         IF active_tcb^.error_sw THEN
  407.           EXIT;
  408.  
  409.       END;
  410.  
  411.     (*-----------------------------------------------------------------------*)
  412.     (* Handle special case of message to SYSOP                               *)
  413.     (*-----------------------------------------------------------------------*)
  414.  
  415.     IF cmd_string = 'S~' THEN
  416.       BEGIN;
  417.  
  418.         (*-------------------------------------------------------------------*)
  419.         (* Put the subject on the memory stack                               *)
  420.         (*-------------------------------------------------------------------*)
  421.  
  422.         cmd_string := 'SYSOP Message';
  423.  
  424.         p := get_task_mem('SUB', LENGTH(cmd_string) + 1);
  425.  
  426.         MOVE(cmd_string, p^, LENGTH(cmd_string) + 1);
  427.  
  428.         (*-------------------------------------------------------------------*)
  429.         (* Fake an SP SYSOP command                                          *)
  430.         (*-------------------------------------------------------------------*)
  431.  
  432.         cmd_string := 'SP SYSOP';
  433.         r_sw := TRUE;
  434.  
  435.       END;
  436.  
  437.     (*-----------------------------------------------------------------------*)
  438.     (* Initialize                                                            *)
  439.     (*-----------------------------------------------------------------------*)
  440.  
  441.     FILLCHAR(active_tcb^.curr_msg, SIZEOF(msg_index_block), CHR(0));
  442.  
  443.     abbs := active_tcb^.tcb_abbs;
  444.  
  445.     (*-----------------------------------------------------------------------*)
  446.     (* Set the msg type and flag                                             *)
  447.     (*-----------------------------------------------------------------------*)
  448.  
  449.     m_t := active_tcb^.curr_msg.msg_i_mb.msg_type;
  450.  
  451.     IF LENGTH(cmd_string) > 1 THEN
  452.       m_t := cmd_string[2]
  453.     ELSE
  454.       m_t := '?';
  455.  
  456.     active_tcb^.curr_msg.msg_i_mb.msg_flag := 0;
  457.  
  458.     (*-----------------------------------------------------------------------*)
  459.     (* Convert blank as needed                                               *)
  460.     (*-----------------------------------------------------------------------*)
  461.  
  462.     IF opt_block.opt_blank_to_p AND (m_t = ' ') THEN
  463.       m_t := mt_private;
  464.  
  465.     IF opt_block.opt_blank_to_p AND (m_t = ' ') THEN
  466.       m_t := mt_private;
  467.  
  468.     (*-----------------------------------------------------------------------*)
  469.     (* Check message type                                                    *)
  470.     (*-----------------------------------------------------------------------*)
  471.  
  472.     i := check_type(m_t);
  473.  
  474.     (*-----------------------------------------------------------------------*)
  475.     (* Handle the case of something is wrong and this is a BBS               *)
  476.     (*-----------------------------------------------------------------------*)
  477.  
  478.     IF (i <> 0) AND ((active_tcb^.uid_data.user_flag AND user_f_bbs) <> 0) THEN
  479.       BEGIN;
  480.  
  481.         IF abbs AND (active_tcb^.tcb_bid_level > 1) THEN
  482.           send_tnc_data_str('LATER' + cr)
  483.         ELSE
  484.           BEGIN;
  485.             send_message(message_smc_type_bad);
  486.             active_tcb^.error_sw := TRUE;
  487.           END;
  488.  
  489.         EXIT;
  490.  
  491.       END;
  492.  
  493.     (*-----------------------------------------------------------------------*)
  494.     (* Prompt non-BBS guys for correct type if it was wrong.  If this is     *)
  495.     (* a BBS then we can't have gotten here with a bad type                  *)
  496.     (*-----------------------------------------------------------------------*)
  497.  
  498.     WHILE (i <> 0) DO
  499.       BEGIN;
  500.  
  501.         send_message(i);
  502.  
  503.         t_str := read_tnc_data_str;
  504.  
  505.         strip_crlf(t_str);
  506.         IF t_str = '' THEN
  507.           BEGIN;
  508.             send_message(message_nodata_can);
  509.             EXIT;
  510.           END;
  511.  
  512.         IF LENGTH(t_str) <> 1 THEN
  513.           m_t := #0
  514.         ELSE
  515.           BEGIN;
  516.             m_t := UPCASE(t_str[1]);
  517.             i := check_type(m_t);
  518.           END;
  519.  
  520.       END;
  521.  
  522.     (*-----------------------------------------------------------------------*)
  523.     (* Save the type                                                         *)
  524.     (*-----------------------------------------------------------------------*)
  525.  
  526.     active_tcb^.curr_msg.msg_i_mb.msg_type := m_t;
  527.  
  528.     (*-----------------------------------------------------------------------*)
  529.     (* Process 'TO' data if present.  If not get some and process it         *)
  530.     (*-----------------------------------------------------------------------*)
  531.  
  532.     IF words(cmd_string) > 1 THEN
  533.       send_msg_to_process(subword(@cmd_string, 2, 0))
  534.     ELSE
  535.       BEGIN;
  536.         send_message(message_smc_to);
  537.  
  538.         t_str := read_tnc_data_str;
  539.         strip_crlf(t_str);
  540.         IF t_str = '' THEN EXIT;
  541.  
  542.         send_msg_to_process(t_str);
  543.       END;
  544.  
  545.     IF active_tcb^.error_sw THEN
  546.       EXIT;
  547.  
  548.     (*-----------------------------------------------------------------------*)
  549.     (* Now processing a message                                              *)
  550.     (*-----------------------------------------------------------------------*)
  551.  
  552.     active_tcb^.tcb_rcv_msg := TRUE;
  553.  
  554.     (*-----------------------------------------------------------------------*)
  555.     (* Test the BID if necessary                                             *)
  556.     (*    b indicates result of BID test                                     *)
  557.     (*    l says that a test was done                                        *)
  558.     (*-----------------------------------------------------------------------*)
  559.  
  560.     IF ((LENGTH(active_tcb^.curr_msg.msg_i_mb.msg_bid) = 1)
  561.                       AND (active_tcb^.curr_msg.msg_i_mb.msg_bid[1] = CHR(0)))
  562.               OR (LENGTH(active_tcb^.curr_msg.msg_i_mb.msg_bid) = 0) THEN
  563.       BEGIN;
  564.         b := FALSE;
  565.         l := FALSE;
  566.       END
  567.     ELSE
  568.       BEGIN;
  569.         b := bid_check;
  570.         l := TRUE;
  571.       END;
  572.  
  573.     (*-----------------------------------------------------------------------*)
  574.     (* Bid failure?                                                          *)
  575.     (*-----------------------------------------------------------------------*)
  576.  
  577.     IF b AND abbs THEN
  578.       BEGIN;
  579.         send_tnc_data_str('NO' + cr);
  580.         EXIT;
  581.       END;
  582.  
  583.     (*-----------------------------------------------------------------------*)
  584.     (* Execute a reject/deny action if there is one                          *)
  585.     (*-----------------------------------------------------------------------*)
  586.  
  587.     IF look_for_reject_deny THEN
  588.       BEGIN;
  589.  
  590.         (*-------------------------------------------------------------------*)
  591.         (*                                                                   *)
  592.         (* NOTE:  If the deny bit is set then we only do case 1.  Messages   *)
  593.         (* originating at another BBS are allowed                            *)
  594.         (*                                                                   *)
  595.         (* Case Action                                                       *)
  596.         (* ---- ------                                                       *)
  597.         (* 1    Non BBS -- Send reject message and quit command              *)
  598.         (*      BBS with no SID -- Take action based on reject action code   *)
  599.         (* 2                          0 -- No reject action.  Use hold       *)
  600.         (* 3                          1 -- Same as zero                      *)
  601.         (* 4                          2 -- Send reject and disconnect        *)
  602.         (*      BBS with just $ -- Take action based on reject action code   *)
  603.         (* 5                          0 -- No reject action.  Use hold       *)
  604.         (* 6                          1 -- Send NO; send reject; quit        *)
  605.         (* 7                          2 -- Send reject and disconnect        *)
  606.         (* 8    BBS with R$     -- Send Reject message and quit command      *)
  607.         (*                                                                   *)
  608.         (*   i is set with the proper bits to signal action to be done       *)
  609.         (*       1 = send no                                                 *)
  610.         (*       2 = send reject                                             *)
  611.         (*       4 = disconnect                                              *)
  612.         (*       8 = quit command                                            *)
  613.         (*-------------------------------------------------------------------*)
  614.  
  615.         (*-------------------------------------------------------------------*)
  616.         (* Handle DENY and a BBS.  If this case is true then no action is    *)
  617.         (* warranted.  If this case is not true then fall thru.  Case 1      *)
  618.         (* will be executed because this code filters all other cases        *)
  619.         (*-------------------------------------------------------------------*)
  620.  
  621.         IF ((this_act^.action_type AND action_msg_deny) <> 0)
  622.                          AND (active_tcb^.uid_data.user_class = user_c_bu) THEN
  623.           GOTO no_reject;
  624.  
  625.         (*-------------------------------------------------------------------*)
  626.         (* Detect non-BBS and BBS with R$  (case 1 and 8)                    *)
  627.         (*-------------------------------------------------------------------*)
  628.  
  629.         IF (active_tcb^.uid_data.user_class <> user_c_bu)
  630.                              OR (abbs AND (active_tcb^.tcb_bid_level > 1)) THEN
  631.           BEGIN;
  632.             i := 2 + 8;
  633.             GOTO do_reject;
  634.           END;
  635.  
  636.         (*-------------------------------------------------------------------*)
  637.         (* Detect case 4 and 7 -- Reject and disconnect                      *)
  638.         (*-------------------------------------------------------------------*)
  639.  
  640.         IF active_port^.reject_act = 2 THEN
  641.           BEGIN;
  642.             i := 2 + 4;
  643.             GOTO do_reject;
  644.           END;
  645.  
  646.         (*-------------------------------------------------------------------*)
  647.         (* Detect case 6                                                     *)
  648.         (*-------------------------------------------------------------------*)
  649.  
  650.         IF abbs AND (active_port^.reject_act = 1) THEN
  651.           BEGIN;
  652.             i := 1 + 2 + 8;
  653.             GOTO do_reject;
  654.           END;
  655.  
  656.         (*-------------------------------------------------------------------*)
  657.         (* Everything left is no action at all (Cases 2, 3, and 5)           *)
  658.         (*-------------------------------------------------------------------*)
  659.  
  660.         GOTO no_reject;
  661.  
  662.         (*-------------------------------------------------------------------*)
  663.         (* Execute the actual actions                                        *)
  664.         (*-------------------------------------------------------------------*)
  665.  
  666. do_reject:
  667.  
  668.         IF (i AND 1) > 0 THEN
  669.           send_tnc_data_str('NO' + cr);
  670.  
  671.         IF (i AND 2) > 0 THEN
  672.           send_message(get_reject_message);
  673.  
  674.         IF (i AND 4) > 0 THEN
  675.           BEGIN;
  676.             send_message(message_op_halted);
  677.             end_session(TRUE);
  678.           END;
  679.  
  680.         IF (i AND 8) > 0 THEN
  681.           EXIT;
  682.  
  683.       END;
  684.  
  685.     (*-----------------------------------------------------------------------*)
  686.     (* End of reject code                                                    *)
  687.     (*-----------------------------------------------------------------------*)
  688.  
  689. no_reject:
  690.  
  691.     (*-----------------------------------------------------------------------*)
  692.     (* Tell about the BID in various means                                   *)
  693.     (*-----------------------------------------------------------------------*)
  694.  
  695.     IF abbs THEN
  696.       BEGIN;
  697.  
  698.         (*-------------------------------------------------------------------*)
  699.         (* This is for an Advanced BBS.  Tell NO on bid as needed            *)
  700.         (*-------------------------------------------------------------------*)
  701.  
  702.         IF b THEN
  703.           BEGIN;
  704.             send_tnc_data_str('NO' + cr);
  705.             EXIT;
  706.           END;
  707.  
  708.         (*-------------------------------------------------------------------*)
  709.         (* If this BBS has "LATER" support, see if we need to send LATER     *)
  710.         (*-------------------------------------------------------------------*)
  711.  
  712.         IF (active_tcb^.tcb_bid_level > 1) AND l THEN
  713.           BEGIN;
  714.             t := ring_tcb;
  715.             REPEAT
  716.  
  717.               IF t^.tcb_rcv_msg
  718.                    AND (t <> active_tcb)
  719.                    AND (active_tcb^.curr_msg.msg_i_mb.msg_bid =
  720.                                             t^.curr_msg.msg_i_mb.msg_bid) THEN
  721.                 BEGIN;
  722.                   send_tnc_data_str('LATER' + cr);
  723.                   EXIT;
  724.                 END;
  725.               t := t^.next_tcb;
  726.  
  727.             UNTIL t = ring_tcb;
  728.           END;
  729.  
  730.         (*-------------------------------------------------------------------*)
  731.         (* If we get here then we want the message                           *)
  732.         (*-------------------------------------------------------------------*)
  733.  
  734.         send_tnc_data_str('OK' + cr);
  735.  
  736.       END
  737.     ELSE
  738.  
  739.         (*-------------------------------------------------------------------*)
  740.         (* This is for a user or old BBS.  Just warn                         *)
  741.         (*-------------------------------------------------------------------*)
  742.  
  743.       IF b THEN
  744.         send_message(message_dupe_bid);
  745.  
  746.     (*-----------------------------------------------------------------------*)
  747.     (* Get a subject                                                         *)
  748.     (*-----------------------------------------------------------------------*)
  749.  
  750.     IF NOT r_sw THEN
  751.       BEGIN;
  752.  
  753.         (*-------------------------------------------------------------------*)
  754.         (* This fetches the subject from anything but a reply.  In certain   *)
  755.         (* circumstances we are going to loop prompting the user for a subj  *)
  756.         (*-------------------------------------------------------------------*)
  757.  
  758.         b := TRUE;
  759.  
  760.         REPEAT;
  761.  
  762.           (*-----------------------------------------------------------------*)
  763.           (* For a non-Advanced BBS, issue the subject prompt                *)
  764.           (*-----------------------------------------------------------------*)
  765.  
  766.           IF NOT abbs THEN
  767.             send_message(message_smc_subj);
  768.  
  769.           (*-----------------------------------------------------------------*)
  770.           (* Read the subject and tuck it away                               *)
  771.           (*-----------------------------------------------------------------*)
  772.  
  773.           t_str := read_tnc_data_str;
  774.  
  775.           strip_crlf(t_str);
  776.           active_tcb^.curr_msg.msg_i_mb.msg_subj := t_str;
  777.  
  778.           (*-----------------------------------------------------------------*)
  779.           (* Unless private, blank subjects are not allowed from users       *)
  780.           (*-----------------------------------------------------------------*)
  781.  
  782.           IF (t_str = '')
  783.                 AND (active_tcb^.uid_data.user_class <> user_c_bu)
  784.                 AND (active_tcb^.curr_msg.msg_i_mb.msg_type <> mt_private) THEN
  785.             BEGIN;
  786.               IF NOT b THEN
  787.                 BEGIN;
  788.                   send_message(message_nodata_can);
  789.                   EXIT;
  790.                 END;
  791.               send_message(message_nosubj);
  792.               b := FALSE
  793.             END
  794.           ELSE
  795.             b := TRUE;
  796.  
  797.         UNTIL b; (*----- Subject prompting loop -----------------------------*)
  798.  
  799.         (*-------------------------------------------------------------------*)
  800.         (* If this is not a BBS then we will make a second pass over the     *)
  801.         (* reject/deny actions                                               *)
  802.         (*-------------------------------------------------------------------*)
  803.  
  804.         IF active_tcb^.uid_data.user_class <> user_c_bu THEN
  805.           BEGIN;
  806.  
  807.             (*---------------------------------------------------------------*)
  808.             (* See if an action exists.  If so, do the reject                *)
  809.             (*---------------------------------------------------------------*)
  810.  
  811.             IF look_for_reject_deny THEN
  812.               BEGIN;
  813.                 send_message(get_reject_message);
  814.                 EXIT;
  815.               END;
  816.  
  817.           END;
  818.  
  819.       END (*----- End subject processing for non-reply ----------------------*)
  820.     ELSE
  821.       BEGIN;
  822.  
  823.         (*-------------------------------------------------------------------*)
  824.         (* This fetches the prestored REPLY subject for an SR command        *)
  825.         (*-------------------------------------------------------------------*)
  826.  
  827.         p := find_task_mem_addr('SUB');
  828.         IF p = NIL THEN
  829.           RUNERROR(nil_subj);
  830.         MOVE(p^, active_tcb^.curr_msg.msg_i_mb.msg_subj, LENGTH(p^) + 1);
  831.         free_task_mem('SUB', TRUE);
  832.  
  833.       END;
  834.  
  835.     (*-----------------------------------------------------------------------*)
  836.     (* Get text                                                              *)
  837.     (*-----------------------------------------------------------------------*)
  838.  
  839.     IF NOT abbs THEN
  840.       send_message(message_smc_text);
  841.  
  842.     t_str := opt_block.msg_file_dir + active_tcb^.port_chan_s + '.IN';
  843.     in_text_file(t_str, TRUE);
  844.  
  845.     IF active_tcb^.error_sw = TRUE THEN
  846.       EXIT;
  847.  
  848.     (*-----------------------------------------------------------------------*)
  849.     (* Set the date/time of origination to when it finished!                 *)
  850.     (*-----------------------------------------------------------------------*)
  851.  
  852.     active_tcb^.curr_msg.msg_i_mb.msg_dt_in := current_day_time;
  853.  
  854.     (*-----------------------------------------------------------------------*)
  855.     (* Set the size                                                          *)
  856.     (*-----------------------------------------------------------------------*)
  857.  
  858.     active_tcb^.curr_msg.msg_i_mb.msg_size := io_file_size;
  859.  
  860.     (*-----------------------------------------------------------------------*)
  861.     (* Add message to list                                                   *)
  862.     (*-----------------------------------------------------------------------*)
  863.  
  864.     add_msg(t_str, FALSE);
  865.  
  866.     (*-----------------------------------------------------------------------*)
  867.     (* Process CC as needed                                                  *)
  868.     (*-----------------------------------------------------------------------*)
  869.  
  870.     make_cc;
  871.  
  872.     (*-----------------------------------------------------------------------*)
  873.     (* Log it                                                                *)
  874.     (*-----------------------------------------------------------------------*)
  875.  
  876.     log_data_is(active_tcb^.curr_msg.msg_i_mb.msg_number, cmd_string);
  877.  
  878.     (*-----------------------------------------------------------------------*)
  879.     (* Tell user                                                             *)
  880.     (*-----------------------------------------------------------------------*)
  881.  
  882.     IF NOT abbs THEN
  883.       send_message(message_added_msg);
  884.  
  885.   END;
  886.  
  887. END.
  888.